home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / tptc17sc.zip / TPTC.PAS < prev    next >
Pascal/Delphi Source File  |  1988-03-26  |  18KB  |  531 lines
  1.  
  2. (*
  3.  * TPTC - Turbo Pascal to C translator
  4.  *
  5.  * S.H.Smith, 9/9/85  (rev. 2/13/88)
  6.  *
  7.  * Copyright 1986, 1988 by Samuel H. Smith;  All rights reserved.
  8.  *
  9.  * See HISTORY.DOC for complete revision history.
  10.  * See TODO.DOC for pending changes.
  11.  *
  12.  *)
  13.  
  14. {$T+}    {Produce mapfile}
  15. {$R-}    {Range checking}
  16. {$B-}    {Boolean complete evaluation}
  17. {$S-}    {Stack checking}
  18. {$I+}    {I/O checking}
  19. {$N-}    {Numeric coprocessor}
  20. {$V-}    {Relax string rules}
  21. {$M 65500,16384,655360} {stack, minheap, maxhep}
  22.  
  23.  
  24. program translate_tp_to_c;
  25.  
  26. uses Dos;
  27.  
  28. const
  29.    version1 =     'TPTC - Translate Pascal to C';
  30.    version2 =     'Version 1.7 03/26/88   (C) 1988 S.H.Smith';
  31.    
  32.    minstack =     4000;       {minimum free stack space needed}
  33.    outbufsiz =    10000;      {size of top level output file buffer}
  34.    inbufsiz =     2000;       {size of input file buffers}
  35.    maxparam =     16;         {max number of parameters to process}
  36.    maxnest =      10;         {maximum procedure nesting-1}
  37.    maxincl =      2;          {maximum source file nesting-1}
  38.    statrate =     5;          {clock ticks between status displays}
  39.    ticks_per_second = 18.2;
  40.    
  41.  
  42. const
  43.    nestfile =     'p$';       {scratchfile for nested procedures}
  44.  
  45. type
  46.    anystring =    string [127];
  47.    string255 =    string [255];
  48.    string80  =    string [80];
  49.    string64  =    string [64];
  50.    string40  =    string [40];
  51.    string20  =    string [20];
  52.    string10  =    string [10];
  53.  
  54.  
  55. (* command options *)
  56.  
  57. const
  58.    debug:         boolean = false;   {-B   trace scan}
  59.    debug_parse:   boolean = false;   {-BP  trace parse}
  60.    mt_plus:       boolean = false;   {-M   true if translating Pascal/MT+}
  61.    map_lower:     boolean = false;   {-L   true to map idents to lower case}
  62.    dumpsymbols:   boolean = false;   {-D   dump tables to object file}
  63.    dumppredef:    boolean = false;   {-DP  dump predefined system symbols}
  64.    includeinclude:boolean = false;   {-I   include include files in output}
  65.    quietmode:     boolean = false;   {-Q   disable warnings?}
  66.    identlen:      integer = 13;      {-Tnn nominal length of identifiers}
  67.    workdir:       string64 = '';     {-Wd: work/scratch file directory}
  68.    tshell:        boolean = false;   {-#   pass lines starting with '#'}
  69.    pass_comments: boolean = true;    {-NC  no comments in output}
  70.  
  71.  
  72. type
  73.    toktypes =     (number,      identifier,
  74.                    strng,       keyword,
  75.                    chars,       comment,
  76.                    unknown);
  77.  
  78.    symtypes =     (s_int,       s_long,
  79.                    s_double,    s_string,
  80.                    s_char,      s_struct,
  81.                    s_file,      s_bool,
  82.                    s_void                );
  83.  
  84.    supertypes =   (ss_scalar,   ss_const,
  85.                    ss_func,     ss_struct,
  86.                    ss_array,    ss_pointer,
  87.                    ss_builtin,  ss_none  );
  88.  
  89.    symptr =      ^symrec;
  90.    symrec =       record
  91.                      symtype:  symtypes;        { simple type }
  92.                      suptype:  supertypes;      { scalar,array etc. }
  93.                      id:       string40;        { name of entry }
  94.                      repid:    string40;        { replacement ident }
  95.  
  96.                      parcount: integer;         { parameter count,
  97.                                                   >=0 -- procedure/func pars
  98.                                                   >=1 -- array level
  99.                                                    -1 -- simple variable
  100.                                                    -2 -- implicit deref var }
  101.  
  102.                      pvar:     word;            { var/val reference bitmap, or
  103.                                                   structure member nest level }
  104.  
  105.                      base:     integer;         { base value for subscripts }
  106.                      limit:    word;            { limiting value for scalars }
  107.  
  108.                      next:     symptr;          { link to next symbol in table }
  109.                   end;
  110.  
  111.    paramlist =    record
  112.                      n:      integer;
  113.                      id:     array [1..maxparam] of string80;
  114.                      stype:  array [1..maxparam] of symtypes;
  115.                      sstype: array [1..maxparam] of supertypes;
  116.                   end;
  117.  
  118. const
  119.  
  120.    (* names of symbol types *)
  121.    typename:  array[symtypes] of string40 =
  122.                   ('int',       'long',
  123.                    'double',    'strptr',
  124.                    'char',      'struct',
  125.                    'file',      'boolean',
  126.                    'void' );
  127.  
  128.    supertypename:  array[supertypes] of string40 =
  129.                   ('scalar',    'constant',
  130.                    'function',  'structure',
  131.                    'array',     'pointer',
  132.                    'builtin',   'none' );
  133.  
  134.  
  135.    (* these words start new statements or program sections *)
  136.    nkeywords = 14;
  137.    keywords:  array[1..nkeywords] of string40 = (
  138.       'PROGRAM',   'PROCEDURE', 'FUNCTION',
  139.       'VAR',       'CONST',     'TYPE',
  140.       'LABEL',     'OVERLAY',   'FORWARD',
  141.       'MODULE',    'EXTERNAL',  'CASE',
  142.       'INTERFACE', 'IMPLEMENTATION');
  143.  
  144. type
  145.    byteptr =      ^byte;
  146.    
  147. var
  148.    inbuf:         array [0..maxincl] of byteptr;
  149.    srcfd:         array [0..maxincl] of text;
  150.    srclines:      array [0..maxincl] of integer;
  151.    srcfiles:      array [0..maxincl] of string64;
  152.    
  153.    outbuf:        array [0..maxnest] of byteptr;
  154.    ofd:           array [0..maxnest] of text;
  155.    
  156.    inname:        string64;         {source filename}
  157.    outname:       string64;         {output filename}
  158.    unitname:      string64;         {output filename without extention}
  159.    symdir:        string64;         {.UNS symbol search directory}
  160.    ltok:          string80;         {lower/upper current token}
  161.    tok:           string80;         {all upper case current token}
  162.    ptok:          string80;         {previous token}
  163.    spaces:        anystring;        {leading spaces on current line}
  164.    decl_prefix:   anystring;        {declaration identifier prefix, if any}
  165.  
  166. const
  167.    starttime:     longint     = 0;      {time translation was started}
  168.    curtime:       longint     = 0;      {current time}
  169.    statustime:    longint     = 0;      {time of last status display}
  170.    
  171.    nextc:         char        = ' ';
  172.    toktype:       toktypes    = unknown;
  173.    ptoktype:      toktypes    = unknown;
  174.    linestart:     boolean     = true;
  175.    extradot:      boolean     = false;
  176.    nospace:       boolean     = false;
  177.  
  178.    cursym:        symptr      = nil;
  179.    curtype:       symtypes    = s_void;
  180.    cexprtype:     symtypes    = s_void;
  181.    cursuptype:    supertypes  = ss_scalar;
  182.    curlimit:      integer     = 0;
  183.    curbase:       integer     = 0;
  184.    curpars:       integer     = 0;
  185.  
  186.    withlevel:     integer     = 0;
  187.    unitlevel:     integer     = 0;
  188.    srclevel:      integer     = 0;
  189.    srctotal:      integer     = 1;
  190.    objtotal:      integer     = 0;
  191.    
  192.    procnum:       string[2]   = 'AA';
  193.    recovery:      boolean     = false;
  194.  
  195.    in_interface:  boolean     = false;
  196.    top_interface: symptr      = nil;
  197.  
  198.    globals:       symptr      = nil;
  199.    locals:        symptr      = nil;
  200.  
  201.  
  202.  
  203. (* nonspecific library includes *)
  204.  
  205. {$I ljust.inc}     {left justify writeln strings}
  206. {$I atoi.inc}      {ascii to integer conversion}
  207. {$I itoa.inc}      {integer to ascii conversion}
  208. {$I ftoa.inc}      {float to ascii conversion}
  209. {$I stoupper.inc}  {map string to upper case}
  210. {$I keypress.inc}  {msdos versions of keypressed and readkey}
  211. {$I getenv.inc}    {get environment variables}
  212.  
  213.  
  214.  
  215. procedure fatal  (message:  string);      forward;
  216. procedure warning  (message:  string);    forward;
  217. procedure scan_tok;                       forward;
  218. procedure gettok;                         forward;
  219. procedure puttok;                         forward;
  220. procedure putline;                        forward;
  221. procedure puts(s: string);                forward;
  222. procedure putln(s: string);               forward;
  223. function  plvalue: string;                forward;
  224. functio